home *** CD-ROM | disk | FTP | other *** search
- Procedure Make_Mini_Map;
- {prepare a 2-dimensional map for 2-dimensional minds}
- Begin;
- For X_Coordinate := 0 to 9 Do
- Begin;
- Mini_Map [X_Coordinate] := '';
- For Y_Coordinate := 0 to 9 Do
- If System_Details [Y_Coordinate, X_Coordinate] >'!'
- then Mini_Map [X_Coordinate] := Mini_Map [X_Coordinate] + '* '
- else Mini_Map [X_Coordinate] := Mini_Map [X_Coordinate] + ' ';
- End;
- End;
-
- Procedure Show_Mini_Map;
- {part of statistics}
- Begin;
- Window(55,1,80,19);
- ClrScr;
- WG_Textcolor(White);
- Writeln(' sector systems');
- Writeln(' 0 1 2 3 4 5 6 7 8 9');
- Writeln;
- For N := 0 to 9 do Writeln(' ',N,' ',Mini_Map[n]);
- Writeln('# = Oxygen World');
- If Binary_Star_Count > 0 then Writeln('< = close binary system');
- If Black_Hole_Count > 0 then Writeln('{ = black hole');
- If ProtoStar_Count > 0 then Writeln('[ = Protostar');
- Window(1,1,80,25);
- End;
-
- Procedure Draw_Grid;
- {Draws a 10 x 10 x 10 3D grid for showing solar system positions etc}
- Begin;
- Colour_Selection;
- WriteLn(' Sector Solar System Locations');
- For I:= 1 to 11 Do
- Begin;
- IA:=I*5; {Local variables speed up plotting}
- IB:=I*9;
- IC:=I*10;
- ID:=I*18;
- Draw(IC,200-IA,IC,110-IA,1);
- Draw(IC,200-IA,180+IC,200-IA,1);
- If I>1 then Begin;
- Numbers(IC-10,105-IA,11-I,3);
- Numbers(3,90+IB,11-I,2);
- Numbers(87+ID,49,I-2,1);
- End;
- Draw(110,46+IB,290,46+IB,1);
- Draw(93+ID,55,93+ID,145,1);
- Draw(93+ID,145,ID-8,195,1);
- Draw(10,95+IB,110,46+IB,1);
- End;
- End;
-
- Procedure System_location_XYZ;
- {Convert XYZ coordinates to XY pairs and show them on grid}
- Begin;
- Y1:=147 + (5 * X_Coordinate);
- Y2:= Y1 - (10 * Z_Coordinate);
- X:= 117 - (10 * X_Coordinate) + (18 * Y_Coordinate);
- Fillshape (X,Y1,3,1);
- Draw (X,Y1,X,Y2+3,2);
- Circle(X,Y2,3,0);
- Fillshape(X,Y2+1,0,0);
- Circle(X,Y2,3,2);
- Fillshape(X,Y2+1,3,2);
- End;
-
- Procedure Random_Systems;
- {Decides if there should be systems at each location, if so it shows them
- and adds their location to a file for future manipulation}
- Begin;
- Systems_In_Memory := 0;
- For Y_Coordinate := 0 to 9 Do
- Begin;
- For X_Coordinate := 0 to 9 Do
- Begin;
- System_Details [Y_Coordinate, X_Coordinate] := ' ';
- Z_Coordinate := Random (50) - 40;
- If Z_Coordinate >= 0 then
- Begin;
- System_Location_XYZ;
- Str (Y_Coordinate, A);
- Str (X_Coordinate, B);
- Str (Z_Coordinate, C);
- System_Location := A + B + C;
- System_Details [Y_Coordinate, X_Coordinate] := System_Location;
- Systems_In_Memory := Systems_In_Memory + 1;
- End;
- End;
- End;
- Make_Mini_Map;
- Beep_Wait;
- End;
-
- Procedure Old_Systems;
- {Convert System_Details data to show Z coordinate}
- Begin;
- A := Copy (System_Details [Y_Coordinate, X_Coordinate], 3, 1);
- Val (A, Z_Coordinate,z);
- End;
-
- Procedure System_Window;
- {Set up a small window for a solar system map}
- Begin;
- GraphWindow(0,0,319,32);
- Draw(0,0,319,0,2);
- Draw(0,32,319,32,2);
- WG_System := System_Details [Y_Coordinate, X_Coordinate];
- GraphWindow(0,1,319,31);
- ClearScreen;
- Draw(0,0,0,30,2);
- Draw(319,0,319,30,2);
- End;
-
- Procedure Binary_Star;
- {Draw a symbol for a close binary star pair}
- Begin;
- Circle(5,16,3,3);
- Fillshape(5,16,2,3);
- Circle(7,14,3,0);
- Circle(7,14,2,2);
- Fillshape(7,14,2,2);
- Circle(7,14,2,3);
- End;
-
- Procedure Single_Star;
- {Symbol for a lone star}
- Begin;
- Circle(5,15,Star_Radius,3);
- Fillshape(5,15,2,3);
- End;
-
- Procedure Black_Hole;
- {Symbol for a black hole, or base for proto-star symbol}
- Begin;
- Circle(5,15,3,2);
- Circle(5,15,4,0);
- Draw(0,14,5,14,2);
- Draw(5,16,10,16,2);
- End;
-
- Procedure Proto_Star;
- {Symbol for a solar system still forming}
- Begin;
- Black_Hole;
- Fillshape(5,15,3,2);
- End;
-
- Procedure Binary_Star_Distant;
- {A second star in distant orbit around the first.}
- Begin;
- Circle(5,15,X,2);
- Circle(X+5,15,Star_Radius+1,0);
- Plot(X+5,15,0);
- Circle(X+5,15,Star_Radius,3);
- Fillshape(X+5,15,2,3);
- End;
-
- Procedure Gas_Giant;
- {Simple image of a gas giant}
- Begin;
- Circle(X+5,15,3,2);
- Circle(X+5,15,4,0);
- Fillshape(X+5,15,3,2);
- Draw(X+2,15,X+8,15,2);
- End;
-
- Procedure Ringed_Giant;
- {Simple image of ringed gas giant}
- Begin;
- Gas_Giant;
- Draw(X-2,11,X+12,19,1);
- End;
-
- Procedure Planet;
- {Simple planet, with colour coding}
- Begin;
- If World_Type >3 then World_Type:= 3; { 1 oxygen, 2 poison atmosphere, 3 airless}
- Circle (X+5,15,2,World_Type);
- Circle (X+5,15,1,World_Type);
- Plot (X+5,15,World_Type);
- If Screen_Selection <> 2 then draw(X+3,13+World_Type,X+7,13+World_Type,0);
- End;
-
- Procedure Ring_World;
- {see the book!}
- Begin;
- Circle (5,15,X Div 3,1);
- For N := 1 to 5 do
- Begin;
- Draw (X Div 3 ,N * 5, X Div 3 + 8,N * 5, 0);
- Draw (X Div 3 ,N * 5 +1, X Div 3 + 8,N * 5+1, 0);
- End;
- Circle (5,15,X,1);
- Circle (5,15,X+1,1);
- Circle (5,15,x+2,3);
- If A = 'Q' then begin;
- Circle (5,15,X,2);
- Circle (5,15,X+1,2);
- end;
- End;
-
- Procedure Belt;
- {Indicate presence of asteroid belt}
- Begin;
- Draw (X+5,12,X+5,18,0);
- Plot (X+5,13,2);
- Plot (X+5,15,2);
- Plot (X+5,17,2);
- End;
-
- Procedure Dust_Cloud;
- {indicate presence of dust cloud}
- Begin;
- For N := 1 to 50 do Plot (X+7-Random(5),28-Random(26),3);
- End;
-
- Procedure Planet_Type;
- {Select type of planet and show on screen}
- Begin;
- Circle(5,15,X,1);
- Draw(X+4,12,X+4,18,0);
- Draw(X+5,12,X+5,18,0);
- If A > '7' then Ringed_Giant
- Else
- If A > '5' then Gas_Giant
- Else
- If A > '0' then Planet
- Else
- Belt
- End;
-
- Procedure Get_Luminosity_ETC;
- Begin;
- {main sequence stars}
- if star_type = 'B0' then Begin; Luminosity := 56000.0; Temperature := 28000.0;
- Exact_Mass := 18.0; Exact_Radius := 10.0; End;
- if star_type = 'B5' then Begin; Luminosity := 1400.0; Temperature := 15500.0;
- Exact_Mass := 6.5; Exact_Radius := 4.4; End;
- if star_type = 'A0' then Begin; Luminosity := 90.0; Temperature := 9900.0;
- Exact_Mass := 3.2; Exact_Radius := 3.2; End;
- if star_type = 'A5' then Begin; Luminosity:= 16.0; Temperature := 8500.0;
- Exact_Mass := 2.1; Exact_Radius := 1.8; End;
- if star_type = 'F0' then Begin; Luminosity := 8.1; Temperature := 7400.0;
- Exact_Mass := 1.7; Exact_Radius := 1.7; End;
- if star_type = 'F5' then Begin; Luminosity:= 3.5; Temperature := 6700.0;
- Exact_Mass := 1.3; Exact_Radius := 1.4; End;
- if star_type = 'G0' then Begin; Luminosity := 1.21; Temperature := 6000.0;
- Exact_Mass := 1.04; Exact_Radius := 1.03; End;
- if star_type = 'G5' then Begin; Luminosity:= 0.67; Temperature := 5500.0;
- Exact_Mass := 0.94; Exact_Radius := 0.91; End;
- if star_type = 'K0' then Begin; Luminosity := 0.42; Temperature := 4900.0;
- Exact_Mass := 0.825; Exact_Radius := 0.908; End;
- if star_type = 'K5' then Begin; Luminosity:= 0.08; Temperature := 4100.0;
- Exact_Mass := 0.570; Exact_Radius := 0.566; End;
- if star_type = 'M0' then Begin; Luminosity := 0.04; Temperature := 3500.0;
- Exact_Mass := 0.489; Exact_Radius := 0.549; End;
- if star_type = 'M5' then Begin; Luminosity:= 0.007; Temperature := 2800.0;
- Exact_Mass := 0.331; Exact_Radius := 0.358; End;
- if star_type = 'M9' then Begin; Luminosity:= 0.001; Temperature := 2300.0;
- Exact_Mass := 0.215; Exact_Radius := 0.201; End;
- {Typical White Dwarf}
- if star_type = 'DG' then Begin; Luminosity:= 0.00006;Temperature := 4500.0;
- Exact_Mass := 0.63; Exact_Radius := 0.012; End;
- Star_Radius := Round(Exact_Radius);
- end;
-
- Procedure Get_Star_Type;
- {part of star_maker and binary star procedures}
- Begin;
- Case Star_Selection of {main sequence ONLY}
- 0..02: Star_Type := 'B0';
- 03..05: Star_Type := 'B5';
- 06..10: Star_Type := 'A0';
- 11..15: Star_Type := 'A5';
- 16..22: Star_Type := 'F0';
- 23..30: Star_Type := 'F5';
- 31..40: Star_Type := 'G0';
- 41..50: Star_Type := 'G5';
- 51..65: Star_Type := 'K0';
- 66..80: star_type := 'K5';
- 81..94: Star_type := 'M0';
- 95..97: Star_Type := 'M5';
- 98..99: Star_Type := 'M9';
- End;
- End;
-
- Procedure Star_Maker;
- {select size and type of star}
- Begin;
- Star_Selection := Random(100 - Star_Chance)+(Star_Chance);
- Star_Chance := Star_Selection;
- Get_Star_Type;
- Get_Luminosity_Etc;
- Stars_In_System := Stars_In_System + 1;
- End;
-
- Procedure New_System_Map;
- {Generate data and draw a simple solar system map in a window}
- Begin;
- System_Window;
- Oxygen_World := 0;
- Star_Chance := 0;
- Primary_Mass := 0;
- Stars_In_System := 0;
- Y := Random(100); {Single Star or Binary?}
- If Y >3 then
- Begin;
- {single star}
- Star_Maker;
- Primary_Luminosity := Luminosity;
- Primary_Mass := Exact_Mass;
- Single_Star;
- Second_Star_Orbit := -10;
- End
- Else
- Begin;
- {binary star}
- Second_Star_Orbit := Y;
- If Second_Star_Orbit = 0 then begin
- Binary_Star; {very close binary pair}
- Star_Selection := Random(40)+10;
- Get_Star_Type;
- Get_Luminosity_etc;
- Primary_Luminosity := Luminosity;
- Primary_Mass := Exact_Mass;
- Star_Selection := 100-Star_Selection;
- Get_Star_Type;
- Get_Luminosity_etc;
- Primary_Luminosity := Primary_Luminosity + Luminosity;
- Primary_Mass := Primary_Mass + Exact_Mass;
- Stars_In_System := 2;
- Star_Type := '*'+ Chr(100-Star_Selection);
- End
- Else begin
- {distant binary pair}
- Star_Maker;
- Primary_Luminosity := Luminosity;
- Primary_Mass := Exact_Mass;
- Single_Star;
- End;
- End;
- Numbers(2,24,Y_Coordinate,1);
- Numbers(7,24,X_Coordinate,3);
- Numbers(12,24,Z_Coordinate,2);
- WG_System := WG_System + Star_Type;
- For I := 1 to 17 Do
- Begin;
- Orbital_Distance := Bode_Number[I] * Primary_Mass; {distance in AU}
- X := 17 * I;
- V := Random((I Div 5) + Sqr(Stars_In_System));
- Temperature := 374.5 * (Exp(Ln(Primary_Luminosity)/4)) / Sqrt (Orbital_Distance);
- If Temperature > 2500 then V:= 1;
- if I <= (Second_Star_Orbit * 2)+1 then V := 1;
- If I > 18-Sqr(Stars_In_System) then V := 1;
- if V = 0 then Begin
- If temperature >= 1200 then If Random(3) = 0 then World_Type := 0
- else World_Type := Random(2) + 3;
- If temperature <1200 then if temperature >= 325 then
- if random(3) = 0 then World_Type := 2
- else if random(3) = 0 then World_Type := Random(2)+3
- else World_Type := 0;
- If temperature < 325 then if Temperature >= 250 then
- if random(3) = 0 then if Stars_In_System = 1
- then World_Type := 1
- else World_Type := Random(3)+2;
- If temperature >= 50 then if Temperature <250 then if
- random(2) = 0 then World_Type := Random(5)+5
- else if Random(2) = 0 then World_Type := 5
- else World_Type := 0;
- If temperature < 50 then if Random(3) = 0 then World_Type := 5
- else World_Type := 0;
- If World_Type = 1 then if Oxygen_World = 1 then World_Type := 3;
- If World_Type = 1 then Oxygen_World := 1;
- Str (World_Type,A);
- If temperature < 50 then if A = '0' then A := 'S';
- WG_System := WG_System + A + ' ';
- If A <='9' then Planet_Type;
- If A = 'S' then Dust_Cloud;
- End
- Else if Second_Star_Orbit = I then
- begin
- Star_Maker;
- Binary_Star_Distant;
- WG_System := WG_System + Star_Type;
- Primary_Luminosity := Primary_Luminosity + (Luminosity / I);
- End
- Else WG_System := WG_System + ' ';
- End;
- System_Details [Y_Coordinate, X_Coordinate] := WG_System;
- End;
-
- Procedure Old_System_Map;
- {Replicate a simple solar system map in a window}
- Begin;
- System_Window;
- WG_System := System_Details [Y_Coordinate, X_Coordinate];
- Numbers(2,24,Y_Coordinate,1);
- Numbers(7,24,X_Coordinate,3);
- Numbers(12,24,Z_Coordinate,2);
- Stars_In_System := 0;
- For I := 0 to 17 Do
- Begin;
- A := Copy (WG_System,(2*I)+4,1);
- If A <> ' ' then
- Begin;
- X := I * 17;
- Case Char(Ord(A[1])) of
- '*': Begin; Binary_Star; Stars_In_System := 2; End;
- '(': Begin; black_hole; Stars_In_System := 3; End;
- ')': Begin; Proto_Star; Stars_In_System := 2; End;
- 'A'..'M': Begin;
- Star_Type := Copy (WG_System,(2*I)+4,2);
- Get_Luminosity_etc;
- If I= 0 then Single_Star else Binary_Star_Distant;
- Stars_In_System := Stars_In_System + 1;
- end;
- 'Q'..'R': Ring_World;
- 'S': Dust_Cloud;
- '0'..'9': Begin;
- Val (A,World_Type,Z);
- Planet_Type;
- End;
- end;
- End;
- End;
- End;
-
- Procedure Solar_Systems;
- {Displays sector on the grid, then shows details of each system}
- Begin;
- If Systems_In_Memory = 0 then if Status > 1 then
- Begin;
- No_Sector_Error;
- Exit;
- End;
- Draw_Grid;
- For Y_Coordinate := 0 to 9 Do
- Begin;
- For X_Coordinate := 0 to 9 Do
- Begin;
- If System_Details [Y_Coordinate, X_Coordinate] > '!' then
- Begin;
- GraphWindow(0,0,319,199);
- Old_Systems;
- System_Location_XYZ;
- If Status = 1 then New_System_Map
- Else Old_System_Map;
- End;
- End;
- End;
- GraphWindow(0,0,319,199);
- Beep_Wait;
- End;
-
- Procedure Steer_Around_Sector;
- {move about sector by cursor keys}
- VAR
- Blob_X, Blob_Y, Exit_Key : Integer;
- Begin;
- If Systems_In_Memory = 0 then
- Begin;
- No_Sector_Error;
- Exit;
- End;
- Writeln;
- Writeln(' Use arrow keys to move around sector');
- Writeln(' use ENTER to select or exit');
- Writeln(' Press a key to start');
- Beep_Wait;
- GraphWindow(0,0,319,199);
- Draw_Grid;
- For Y_Coordinate := 0 to 9 Do
- For X_Coordinate := 0 to 9 Do
- If System_Details [Y_Coordinate, X_Coordinate] > '!' then begin;
- Old_Systems;
- System_Location_XYZ;
- end;
- Exit_Key := 0; X_Coordinate := 0; Y_Coordinate := 0;
- Repeat;
- If System_Details [Y_Coordinate, X_Coordinate] > '!' then begin;
- Old_Systems;
- GraphWindow(0,0,319,199);
- Y1:=147 + (5 * X_Coordinate);
- Blob_Y:= Y1 - (10 * Z_Coordinate);
- Blob_X:= 117 - (10 * X_Coordinate) + (18 * Y_Coordinate);
- GetPic(cursor_Buffer,Blob_X-10,Blob_Y-10,Blob_X+10,Blob_Y+10);
- Circle(Blob_X,Blob_Y,2,2);
- Fillshape(Blob_X,Blob_Y,2,2);
- Old_System_Map;
- Graphwindow(0,0,319,199);
- Circle(Blob_X,Blob_Y,2,3);
- Fillshape(Blob_X,Blob_Y,3,3);
- PutPic(cursor_buffer,Blob_X-10,Blob_Y+10);
- end
- Else
- begin;
- System_Window;
- Numbers(2,24,Y_Coordinate,1);
- Numbers(7,24,X_Coordinate,3);
- GraphWindow(0,0,319,199);
- Y1:=147 + (5 * X_Coordinate);
- X:= 117 - (10 * X_Coordinate) + (18 * Y_Coordinate);
- GetPic(cursor_Buffer,X-10,Y1-10,X+10,Y1+10);
- For N:= 1 to 5 do
- begin;
- Circle(X,Y1,2,2);
- Delay(20);
- circle(X,Y1,2,0);
- End;
- PutPic(cursor_buffer,X-10,Y1+10);
- End;
- Read(Kbd,Dummy);
- If (Dummy = #27) and KeyPressed then begin;
- read (Kbd,Dummy);
- Case Dummy of
- 'H': if X_Coordinate > 0 then X_Coordinate := X_Coordinate - 1;
- 'P': if X_Coordinate < 9 then X_Coordinate := X_Coordinate + 1;
- 'K': if Y_Coordinate > 0 then Y_Coordinate := Y_Coordinate - 1;
- 'M': if Y_Coordinate < 9 then Y_Coordinate := Y_Coordinate + 1;
- end;
- end
- else if Dummy = Chr(13) then Exit_Key := 1;
-
- Until Exit_Key <> 0;
- End;
-
-
- {-------------------------------------------------------------------------}
- { SOLAR SYSTEM FILE LOADING AND SAVING }
- {-------------------------------------------------------------------------}
-
- Procedure Get_Directory(Files_Wanted: String);
- {look for files and show them on screen}
- Var
- Dirinfo : Searchrec;
- Begin
- Findfirst (Files_Wanted,archive,dirinfo);
- While DosError = 0 do begin;
- Write(dirinfo.Name:20);
- Findnext(dirinfo);
- end;
- Writeln;
- end;
-
- Procedure Disk_File_Name;
- {Get disk file name and try to avoid errors}
- Begin;
- Writeln('Sector files on disk are:');
- Get_Directory('*.SEC');
- Writeln(diskfree(0) div 1024,' Kbytes free');
- If Demonstration = 0 then repeat
- Writeln('Enter File Name in format [d:]filename {without any extension} ');
- Readln(Sector_Name);
- Until Sector_Name <> ''
- Else Sector_Name := 'SAMPLE';
- File_name := Sector_Name + '.DOC';
- Sector_Name := Sector_Name + '.SEC';
- Writeln (' ' + Sector_Name);
- Assign (Sector_File, Sector_Name);
- End;
-
- Procedure Save_Data;
- {Save system description strings to disk}
- Begin;
- Top_Of_Menu_Screens;
- If Systems_In_Memory = 0 then
- Begin;
- No_Sector_Error;
- Exit;
- End;
- Writeln('Saving Sector Data');
- Disk_File_Name;
- {$I-};
- Rewrite (Sector_File);
- {$I+};
- OK := (IOresult = 0);
- if not OK then begin;
- Show_Disk_Error(2);
- Close (Sector_File);
- Exit;
- End;
- For Y_Coordinate := 0 to 9 Do
- Begin;
- For X_Coordinate := 0 to 9 Do
- Begin;
- Writeln (Sector_File, System_Details [Y_Coordinate, X_Coordinate]);
- End;
- End;
- Close (Sector_File);
- End;
-
- Procedure Read_Data;
- {Read system description strings from disk}
- Begin;
- Top_Of_Menu_Screens;
- Writeln('Loading Sector Data');
- Disk_File_Name;
- {$I-};
- Systems_In_Memory := 0;
- Reset (Sector_File);
- For Y_Coordinate := 0 to 9 Do
- Begin;
- For X_Coordinate := 0 to 9 Do
- Begin;
- Readln (Sector_File, System_Details [Y_Coordinate, X_Coordinate]);
- If System_Details [Y_Coordinate, X_Coordinate] > '!'
- then systems_In_Memory := Systems_In_Memory +1;
- End;
- End;
- Close (Sector_File);
- {$I+}
- OK := (IOresult = 0);
- if not OK then begin;
- Show_Disk_Error(1);
- Exit;
- End;
- Writeln('Sector file loaded');
- ShowText;
- Make_Mini_Map;
- End;